;;-------------------------------------------------
;; An evolotion simulation based on the evolution
;; game from Conrad Barski's Land of Lisp book.
;;
;; == Has an openGL display via JOGL ==
;;-------------------------------------------------

(ns evolol.core
  (:use clojure.pprint
        clojure.inspector))

(def *width*  (ref 1000))
(def *height* (ref 600))
(def *jungle* [60 60 60 60])
(def *plant-energy* 140)
(def *reproduction-energy* 1200)
(def *type-cntr* (atom 0))
(def *plants* (atom {}))
(def *animals* (atom {}))

;; field is a 2d vector of atoms to cells
(def *field* (atom nil))

(deftype Coord [x y]) ;not yet used. might be easier than having separate x and y's?

(defn get-cell
  ([x y]
   (-> @*field* (get x) (get y)))
  ([coord]
   (-> @*field* (get (. coord x)) (get (. coord y)))))

(defprotocol proto-critter
  ;; protocol for the animal objects
  (get-x [_])
  (get-y [_])
  (get-energy [_])
  (get-dir [_])
  (get-genes [_])
  (set-x [_ new-x])
  (set-y [_ new-y])
  (set-energy [_ new-energy])
  (set-dir [_ new-dir])
  (set-genes [_ new-genes])
  (deep-clone [this]))

(defrecord critter [x y energy dir genes]
  ;; defines the animal objects
  proto-critter
  (get-x [_] @x)
  (get-y [_] @y)
  (get-energy [_] @energy)
  (get-dir [_] @dir)
  (get-genes [_] @genes)
  (set-x [_ new-x] (reset! x new-x))
  (set-y [_ new-y] (reset! y new-y))
  (set-energy [_ new-energy] (reset! energy new-energy))
  (set-dir [_ new-dir] (reset! dir new-dir))
  (set-genes [_ new-genes] (reset! genes new-genes))
  (deep-clone [this]
              (let [clone (critter. (atom (get-x this))
                                    (atom (get-y this))
                                    (atom (get-energy this))
                                    (atom (get-dir this))
                                    (atom (get-genes this)))]
                clone )))

(defn animals-add [key val]
  (swap! *animals* assoc key val)
  (reset! (get-cell (get-x val) (get-y val)) val))

(defn animals-rem [key]
  (let [animal (get @*animals* key)]
    (reset! (get-cell (get-x animal) (get-y animal)) :empty)
    (swap! *animals* dissoc key)))

(defn random-animal []
  ;; initiate with 1 animal
  (let [animal (critter. (atom (rand-int @*width*))
                         (atom (rand-int @*height*))
                         (atom (/ *reproduction-energy* 2))
                         (atom 0)
                         (atom [(rand-int 10) (rand-int 10)
                               (rand-int 10) (rand-int 10)]))]
    animal ))

(defn random-plant [coords] ; left top width height
  ;;random coords for a plant
  (let [x (+ (get coords 0) (rand-int (get coords 2)))
        y (+ (get coords 1) (rand-int (get coords 3)))
        pos [x y]
        cell (get-cell x y)]
     (when (not (instance? critter @cell))
       (do
         (reset! *plants*
                 (assoc @*plants* pos true))
         (reset! cell
                 :plant)))))

(defn add-plants []
  ;; for a plant in jungle area an one in the general world
  (random-plant *jungle*)
  (random-plant [0 0 @*width* @*height*]))

(defn remove-plant [coord]
  ;; plant has been eaten
  (reset! *plants*
          (dissoc @*plants* coord))
  (reset! (get-cell (nth coord 0) (nth coord 1))
          :empty))

(defn turn [animal]
  ;; establish the direction for the next move
  (let [x (rand-int (apply + (get-genes animal)))]
    (letfn [(angle [lf-genes x]
                   (let [xnu (- x (first lf-genes))]
                     (if (< xnu 0)
                       0
                       (inc (angle (rest lf-genes) xnu)))))]
      (set-dir animal 
               (mod (+ (get-dir animal)
                       (angle (seq (get-genes animal))
                              x))
                    4 )))))

(defn dir-to-offset [dir]
  {:x (cond (= dir 0) 1
            (= dir 2) -1
            :else 0)
   :y (cond (= dir 1) -1
            (= dir 3) 1
            :else 0)})

(defn cell-in-front [animal] ;not used
  (let [dir (get-dir animal)
        offset (dir-to-offset dir)
        new-x (+ (get-x animal) (:x offset))
        new-y (+ (get-y animal) (:y offset))]
    (get-cell new-x new-y)))

(defn eat [animal]
  ;; animals coords are the same as a plant, animal eats plant.
  (let [pos [(get-x animal)
             (get-y animal)]]
    (when (@*plants* pos)
      (set-energy animal
                  (+ (get-energy animal) *plant-energy*))
      (remove-plant pos))))

(defn move [animal]
  ;; move the animal 1 step
  (let [dir (get-dir animal)
        offset (dir-to-offset dir)
        new-x (+ (get-x animal) (:x offset))
        new-y (+ (get-y animal) (:y offset))
        next-cell (get-cell new-x new-y)] ; is nil if out of bounds
    (when (and (not (= next-cell nil))
               (not (instance? critter @next-cell)))
      (reset! (get-cell (get-x animal) (get-y animal)) :empty)
      (set-x animal new-x)
      (set-y animal new-y)
      (set-energy animal
                  (dec (get-energy animal)))
      (eat animal)
      (reset! (get-cell new-x new-y) animal))))

(defn reproduce [animal]
  ;; asexual reproduction with a little mutation
  (let [e (get-energy animal)
        dir (get-dir animal)
        offset (dir-to-offset dir)
        new-x (+ (get-x animal) (:x offset))
        new-y (+ (get-y animal) (:y offset))
        next-cell (get-cell new-x new-y)]
    (when (and
            (>= e *reproduction-energy*)
            (not (= next-cell nil))
            (not (instance? critter @next-cell)))
      (set-energy animal (float (/ e 2)))
      (let [animal-nu (deep-clone animal)
            genes (vec (map atom (get-genes animal)))
            mutation (rand-int 4)]
        (reset! (get genes mutation)
                (max 1 (+ @(get genes mutation) (rand-int 3) -1)))
        (set-x animal new-x)
        (set-y animal new-y)
        (set-genes animal-nu (vec (map deref genes)))
        (animals-add (swap! *type-cntr* + 1) animal-nu)
        (eat animal-nu)))))

(defn update-world []
  ;; first remove animals with 0 or less energy
  ;; then run all the survivors
  (dorun (map (fn [animal-key]
                (when (<= (get-energy (@*animals* animal-key)) 0)
                  (animals-rem animal-key)))
              (keys @*animals*)))
  (dorun (map (fn [animal]
                (turn animal)
                (move animal)
                ;(eat animal) ;moved into (move)
                (reproduce animal)
                ;(Thread/sleep 0 10) ;sleep between animal updates (temporary)
                )
              (vals @*animals*)))
  (add-plants))

(defn init-field []
	(reset! *field*
	     (apply vector
	         (map (fn [_]
	                (apply vector (map (fn [_] (atom :empty))
	                                   (range @*height*))))
	              (range @*width*)))))

(defn no-ui-go [n]
  ;; add an initial animal and loop n times
  (animals-add 0 (random-animal))
  (dotimes [i n]
    (time (update-world))))

(defn defoliate []
  ;; kill all plants!
  (dorun (map (fn [plant] (remove-plant plant))
              (keys @*plants*))))

(defn exterminate []
  ;; kill all animals!!
  (dorun (map (fn [animal-key]
                (animals-rem animal-key))
              (keys @*animals*))))
